home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / disk_425.arc / PLOT.LIB < prev    next >
Text File  |  1986-06-20  |  3KB  |  147 lines
  1.  
  2. procedure plot(        { with arrays }
  3.         x,        { as independant variable }
  4.         y,        { as dependant variable }
  5.         ycalc        { as fitted curve }
  6.         : ary;
  7.     { and }    m : integer    { number of points });
  8.  
  9. { plot y and ycalc as a function of x for m points }
  10. { if m is negative, only x and y are plotted }
  11.  
  12. const    blank    = ' ';
  13.     linel    = 51;
  14.  
  15. var
  16.     ylabel        : array[1..6] of real;
  17.     out        : array[1..linel] of char;
  18.     lines,i,j,jp,l,n: integer;
  19.     iskip,yonly    : boolean;
  20.  
  21.     xlow,xhigh,xnext,xlabel,xscale,signxs,
  22.     ymin,ymax,change,yscale,ys10        : real;
  23.  
  24. function pscale(p: real): integer;
  25. begin
  26.   pscale:=trunc((p-ymin)/yscale+1)
  27. end;    { pscale}
  28.  
  29. procedure outlin(xname: real);
  30. { output a line }
  31.  
  32. var    i,max    : integer;
  33.  
  34. begin
  35.   write(xname:8:2,blank);    { line label }
  36.   max:=linel+1;
  37.   repeat        { skip blanks on end of line }
  38.     max:=max-1
  39.   until (out[max]<>blank) or (max=1);
  40.   for i:=1 to max do
  41.     write(out[i]);
  42.   writeln;
  43.   for i:=1 to max do
  44.     out[i]:=blank    { blank next line }
  45. end;    { outlin}
  46.  
  47. procedure setup(index: integer);
  48. { setup the plus and asterisk for printing }
  49.  
  50. const    star = '*';
  51.     plus = '+';
  52.  
  53. var    i    : integer;
  54.  
  55. begin
  56.   i:=pscale(y[index]);
  57.   out[i]:=plus;
  58.   if not yonly then
  59.     begin        { add ycalc too }
  60.       i:=pscale(ycalc[index]);
  61.       out[i]:=star
  62.     end
  63. end;        { setup }
  64.  
  65.  
  66. begin        { body of plot }
  67.   if m>0 then        { plot y and ycalc vs x }
  68.     begin
  69.       n:=m;
  70.       yonly:=false
  71.     end
  72.   else        { plot only y vs x }
  73.     begin
  74.       n:=-m;
  75.       yonly:=true
  76.     end;
  77.   { space out alternate lines }
  78.   lines:=2*(n-1)+1;
  79.   writeln;
  80.   xlow:=x[1];
  81.   xhigh:=x[n];
  82.   ymax:=y[1];
  83.   ymin:=ymax;
  84.   xscale:=(xhigh-xlow)/(lines-1);
  85.   signxs:=1.0;
  86.   if xscale<0.0 then signxs:=-1.0;
  87.   for i:=1 to n do
  88.     begin
  89.       if y[i]<ymin then ymin:=y[i];
  90.       if y[i]>ymax then ymax:=y[i];
  91.       if not yonly then
  92.     begin
  93.       if ycalc[i]<ymin then ymin:=ycalc[i];
  94.       if ycalc[i]>ymax then ymax:=ycalc[i]
  95.     end    { if yonly }
  96.   end;
  97.   yscale:=(ymax-ymin)/(linel-1);
  98.   ys10:=yscale*10;
  99.   ylabel[1]:=ymin;    { y axis }
  100.   for i:=1 to 4 do
  101.     ylabel[i+1]:=ylabel[i]+ys10;
  102.   ylabel[6]:=ymax;
  103.   for i:=1 to linel do
  104.     out[i]:=blank;    { blank line }
  105.   setup(1);
  106.   l:=1;
  107.   xlabel:=xlow;
  108.   iskip:=false;
  109.  
  110.   for i:=2 to lines do        { set up a line }
  111.     begin
  112.       xnext:=xlow+xscale*(i-1);
  113.       if iskip then writeln(' -')
  114.       else
  115.     begin
  116.       l:=l+1;
  117.       while
  118.         (x[l]-(xnext-0.5*xscale))*signxs<=0.0 do
  119.           begin
  120.         setup(l);    { setup print line }
  121.         l:=l+1
  122.        end;        { while }
  123.     outlin(xlabel);    { print a line }
  124.     for j:=1 to linel do
  125.       out[j]:=blank        { blank line }
  126.       end;        { if skip }
  127.     if (x[l]-(xnext+0.5*xscale))*signxs>0.0 then iskip:=true
  128.       else
  129.     begin
  130.       iskip:=false;
  131.       xlabel:=xnext;
  132.       setup(l)        { setup print line }
  133.     end
  134.     end;        { for-loop }
  135.   outlin(xhigh);    { last line }
  136.   write('    ');
  137.   for i:=1 to 6 do
  138.     write('     ^    ');
  139.   writeln;
  140.   write('   ');
  141.   for i:=1 to 6 do
  142.     write(ylabel[i]:9:1,blank);
  143.   writeln;
  144.   writeln
  145. end;            { PLOT }
  146.  
  147.